(* CIS 341 *)
(* Author: Steve Zdancewic *)

(* A compilation unit is a collection of labeled, global data *)
(* It is processed by "as" -- the assembler                   *)

(* Global Data Values *)

type global =
| GStringz of string
| GSafeStringz of string 
| GInt32 of int32
| GZero  of int          
| GExtern                

type global_data = {
  link   : bool;         
  label  : X86.lbl;
  value  : global;
}

(* Quotes a string for printing to the listing, appending
 * the null terminator. *)
let quote_asm_string s =
  let outbuf = Buffer.create (String.length s) in
  Buffer.add_char outbuf '\"';
  String.iter (function
    | '\n' -> Buffer.add_string outbuf "\\n"
    | '\"' -> Buffer.add_string outbuf "\\\""
    | '\\' -> Buffer.add_string outbuf "\\\\"
    | '\t' -> Buffer.add_string outbuf "\\t"
    | c -> Buffer.add_char outbuf c
    ) s;
  Buffer.add_string outbuf "\\0\"";
  Buffer.contents outbuf

let string_of_global_data d =
  let maybe_global = if (d.link || d.value = GExtern) then (
      ".globl " ^ (X86.string_of_lbl d.label) ^ "\n"
    ) else "" in
  let data_defn =
    match d.value with
    | GSafeStringz s -> "\t.long " ^ (string_of_int (String.length s)) ^ 
        "\n\t.ascii " ^ (quote_asm_string s)
    | GStringz s -> "\t.ascii " ^ (quote_asm_string s)
    | GInt32 v -> "\t.long " ^ (Int32.to_string v)
    | GZero z -> "\t.zero " ^ (string_of_int z)
    | GExtern -> ""

  in
    maybe_global ^ 
      (if (d.value <> GExtern) then
         (X86.string_of_lbl d.label) ^ ":\n" ^ data_defn ^ "\n"
       else "")
      
(* Compilation Units are Lists of Components *)
type component =
  | Code of X86.insn_block
  | Data of global_data
      
type cunit = component list

let mode_data = "\t.data\n"
let mode_text = "\t.text\n"

let serialize_cunit (cu:cunit) (printfn : string -> unit) =
  (* x86 does not generally require alignment on natural boundaries
   * (i16: even-numbered addresses; i32: divisible by 4; i64: divisible by 8)
   * but the performance of programs will improve if this alignment is
   * maintained wherever possible. The processor may require two
   * memory accesses to read a single unaligned memory address. (see: 
   * IA-32 Intel Architecture Software Developer's Manual, Volume 1, 4-2) *)
  printfn "\t.align 4\n";
  ignore (List.fold_left 
	    (fun mode ni ->
	       let mode' =
		 match ni with
		   | Code c ->
		       (if mode <> mode_text then printfn mode_text);
		       X86.serialize_insn_block c printfn;
		       mode_text
		   | Data d ->
		       (if mode <> mode_data then printfn mode_data);  
		       printfn (string_of_global_data d);
		       mode_data
	       in mode'
	    ) "" cu)
    
let string_of_cunit cu =
  let b = Buffer.create 256 in
    (serialize_cunit cu (Buffer.add_string b));
    Buffer.contents b
      
let output_cunit (cu:cunit) (oc:out_channel) =
  serialize_cunit cu (output_string oc)
    
